home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / commodore-scene-files / Coverdisks / CDU / V4D11.D64 / udg compressor (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  2.5 KB  |  67 lines
  1. 1 POKE53280,0:POKE53281,0:PRINTCHR$(8):POKE53272,20
  2. 2 PRINT"[147]HUMPTY SOFTWARE CHARACTER SET COMPRESSOR"
  3. 3 PRINT"(C) AND WRITTEN HUMPTY DAMIEN MARSH 1988"
  4. 4 PRINT"FOR USE BY HUMPTY SOFTWARE PERSONAL ONLY"
  5. 5 PRINT"CHAR.SET SHOULD ALREADY HAVE BEEN LOADED"
  6. 6 PRINT"WHAT MEMORY POSITION DOES THE SET BEGIN?"
  7. 7 GOSUB50:IFA<6000ORA>53000OR(A>40000ANDA<49000)ORA/2048<>INT(A/2048)THEN7
  8. 8 S=A:PRINT"LAST CHAR.IN SET IS CHAR.NO. (INCLUSIVE)"
  9. 9 GOSUB50:IFA<2ORA>255THEN9
  10. 10 L=A:PRINT"SCANNING SET FOR DUPLICATES. PLEASE WAIT"
  11. 11 DIMC(L),D(L),E(L):C(0)=256:E=0:FORI=1TOL:FORJ=0TOI-1:F=0
  12. 12 FORK=0TO7:IFPEEK(S+I*8+K)<>PEEK(S+J*8+K)THENF=1
  13. 13 NEXT:ONFGOTO14:C(I)=J:J=I:GOTO15
  14. 14 C(I)=256:E=1
  15. 15 NEXT:NEXT:IFE=0THENPRINT"SORRY, THERE'S NO DUPLICATES IN CHAR.SET":GOTO49
  16. 16 PRINT"SCAN COMPLETE. TABLE OF DUPLICATES READY"
  17. 17 PRINT"PRINT TABLE OF DUPLICATES ON THE SCREEN?"
  18. 18 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO18,19:F=1:GOSUB52
  19. 19 PRINT"LIST TABLE OF DUPLICATES TO THE PRINTER?"
  20. 20 PRINT"IF 'Y' THEN ENSURE THAT PRINTER IS READY"
  21. 21 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO21,23:F=0:OPEN1,4:CMD1:GOSUB52
  22. 22 PRINTCHR$(13)
  23. 23 CLOSE1:OPEN3,3:CMD3:PRINT"OPTIONS: (Q)UIT NOW,(D)ELETE DUPLICATES,"
  24. 24 PRINT"[145](C)OMPRESS CHARSET. PRESS (Q),(D) OR (C)"
  25. 25 GOSUB51:ON((A$="Q")*-1)+((A$="D")*-2)+((A$="C")*-3)+1GOTO25,49,26,34
  26. 26 PRINT"NUMBER TO FILL DELETED CHARACTERS WITH ?"
  27. 27 GOSUB50:IFA<0ORA>255THEN28
  28. 28 PRINT"FILLING DUPLICATES WITH THE ABOVE NUMBER"
  29. 29 F=A:FORI=0TOL:IFC(I)<256THENFORJ=0TO7:POKES+I*8+J,F:NEXT
  30. 30 NEXT:PRINT"COMPLETE. DUPLICATES ARE NOW ALL DELETED"
  31. 31 FORI=0TOL:IFC(I)<256THEND(I)=C(I):GOTO33
  32. 32 D(I)=I
  33. 33 NEXT:GOTO43
  34. 34 PRINT"REMOVING DUPLICATES AND COMPRESSING SET.":Z=0:D(0)=0
  35. 35 Z=Z+1:D(Z)=Z:IFC(Z)=256THEN35
  36. 36 J=Z:FORI=ZTOL:FORK=0TO7:POKE14336+J*8+K,PEEK(14336+I*8+K):NEXT
  37. 37 IFC(I)=256THEND(I)=J:J=J+1:GOTO39
  38. 38 D(I)=D(C(I))
  39. 39 NEXT:L1=J-1:PRINT"COMPLETE.  NUMBER TO FILL EXCESS CHARS ?"
  40. 40 GOSUB50:IFA<0ORA>255THEN40
  41. 41 Z=A:FORI=S+L1*8TOS+2047:POKEI,Z:NEXT
  42. 42 PRINT"COMPLETE. THERE ARE NOW"L1"CHARS USED."
  43. 43 PRINT"LIST OLD CHARS/NEW CHARS TABLE TO SCREEN"
  44. 44 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO44,45:F=1:GOSUB60
  45. 45 PRINT"LIST OLD CHAR/NEW CHAR TABLE TO PRINTER?"
  46. 46 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO46,48:F=0:OPEN1,4:CMD1:GOSUB60
  47. 47 PRINTCHR$(13):CLOSE1:CLOSE3:OPEN3,3:CMD3
  48. 48 PRINT"I SUGGEST THAT YOU SAVE YOUR NEW SET NOW"
  49. 49 PRINT"[145][155]":END
  50. 50 GOSUB51:A=VAL(A$)-((A$="0")/10):ON-(A=0)GOTO50:A=INT(A):RETURN
  51. 51 POKE19,2:PRINT"[145]>";:INPUTA$:POKE19,0:PRINT:RETURN
  52. 52 PRINT:GOSUB58
  53. 53 FORI=0TOL:PRINTITAB(20):IFC(I)=256THENPRINT"*****":GOTO55
  54. 54 PRINTC(I)
  55. 55 IFPEEK(214)=24ANDF=1THENWAIT198,1:POKE198,0:GOSUB58
  56. 56 NEXT:IFF=1ANDPEEK(214)>17THENWAIT198,1:POKE198,0
  57. 57 RETURN
  58. 58 IFFTHENPRINT"[147]";
  59. 59 PRINT"CHARACTER NUMBER"SPC(4)"IS IDENTICAL TO":PRINT:RETURN
  60. 60 PRINT:GOSUB65
  61. 61 FORI=0TOL:PRINTITAB(20)D(I)
  62. 62 IFPEEK(214)=24ANDF=1THENWAIT198,1:POKE198,0:GOSUB65
  63. 63 NEXT:IFF=1ANDPEEK(214)>19THENWAIT198,1:POKE198,0
  64. 64 RETURN
  65. 65 IFFTHENPRINT"[147]";
  66. 66 PRINT"OLD CHARSET"SPC(9)"NEW CHARSET":PRINT:RETURN
  67.